Proyecto de Estadística y Programación con R.
Integrantes:
- Viridiana Escarzaga Solis
- Carlos Sebastián Madrigal Rodríguez
- Diego Armando Morales Corona
- Carlos Rodríguez Tenorio
03 de febrero de 2021
Introducción.
A partir de los primeros meses de 2020, México ha visto el impacto generado por la pandemia mundial de SARS-COV2. El primer caso confirmado, en México, se registró el 28 de febrero de 2020. Pocos días después el Gobierno Mexicano declaró la llamada Jornada Nacional de Sana Distancia, en la cuál invitaban a la población a permanecer en casa con el fin de evitar una rápida propagación del virus.
Esta medida, como era de esperarse, tuvo gran impacto en la normalidad de la sociedad implicando problemas socio-económicos, por mencionar algunos: pérdida de enpleo por parte de algunos sectores de la población o dificultad para ejercerlo, disminución en el salario, imortante disminución en el consumo de servicios, etc.
Dado lo anterior resultá interesante preguntarse: ¿Cómo se ha visto afectados algunos indicadores socieconomicos a lo largo de este periodo de tiempo?. El presente trabajo busca estudiarlos y analizarlos, mediante el uso de técnicas de series de tiempo, así como pronosticar el comportamiento de estos.
La movilidad se vio limitada, los medios de transporte vieron una reducción en uso significativa, comportamiento que se esperaba ser al contrario cn los tranportes particulares, ya que podían ser una forma más segura de trasladarse de un lugar a otro.
Tras el brote de la COVID-19, cada vez más personas trabajan, estudian y socializan desde sus casas. A lo largo de la cadena de valor de Internet, los operadores de comunicaciones, los proveedores de contenido y servicios en la nube, así como también los puntos de intercambio de Internet (IXP), han experimentado hasta un 60% más de tráfico de Internet en comparación con el tráfico previo al brote. En esta situación sin precedentes, la resiliencia y la capacidad de las redes de banda ancha se han vuelto aún más esenciales. (consulte mas aqui)
Por otra parte, el dólar es conosiderado un referente en la economía mundial particularmente para las economías Latinoamericanas, cuyas monedas se han visto depreciadas a lo largo de todo este periodo, afectando para bien o para mal otras industrias, repercutiendo tanto en la inflación como en la deuda publica.
" El desarrollo de la pandemia y la expectativa de recuperación económica global son los principales factores fundamentales que determinan el tipo de cambio", esta es otra variable de estudio en este docuemnto.
Información sobre los Datos.
Se buscaron diversas fuentes de información de las cuales obtener las series de tiempo:
- Los indicadores de movilidad se extrajeron de el Portal de Datos Abiertos, en el cual se encontraban series de tiempo de las afluencias en diversos medios de tránsporte en CDMX, registradas desde finales de marzo de 2020 hasta finales de enero de 2021.
Los datos de esta serie son diferencias porcentuales diarias respecto a lo definido como un día típico. La definición de este día típico se baso en un histórico desde 2018 para calcular la afuencia promedio para cada día de la semana ajustados con la afluencia registrada durante la primera quincena de marzo de 2020. Más información
Los indicadores de movilidad de los vehículos particulares (obtenidos aquí), se calculan de una manera similar a los indices de movilidad en el transporte, con la diferencia de que la alfuencia en un día típico se calculó respecto a un histórico desde la segunga semana de enero y febrero de 2020 Más información
El trafico diario de internet se extrajo del portal abierto de la comision de regulacion de comunicaciones. Varios de los proveedores de servicios digitales son reconocidos y usados a lo largo de todo el continente americano. (consulte mas aqui)
La información de trafico diario reportado por los Proveedores de Servicio de Internet, fue recopilada desde el 30 de marzo del 2020 hasta el 26 de enero del 2021. (Obtenidos aqui)
La base de datos proporcionada, nos brinda la cantidad de datos (en GB) que circulan a traves de distintos proveedores de servicios digitales por medio de su infraestructura de red. Este dataset contempla distintos provedores que presentan comportamientos identicos a lo largo e la pandemia, por lo cual podrian ser omitidos para evitar estudiar informacion muy parecida en las series.
- El data set a analizar (de las cambios del precio del dólar) contempla la fluctuación del tipo de cambio a partir del viernes 20 de marzo cuando se decreto la cuarentena y las medidas de quedarse en casa, y de solo contemplar actividades escenciales se llevaron a cabo y concluye el ultimo día del año 2020.
La apertura y el cierre por día son indicadores que da la bolsa de valores para poder observar la diferencia entre estos de acuerdo a las especulaciones del mercado.
Consideraciones.
Dado que se va a estudiar sobre series de tiempo, es importante tener en cuenta que el ajuste de modelos debe generar, en los residuales, ruido blanco cuyas características son el hecho de tener media cero, varianza constante y que estos no esten altamente correlacionados.
Considerando esto en la mayoría de los modelos se ultilizara para métrica la Prueba de hípotesis de Box-Ljung, cuyas hipótesis son:
\(H_0\): Ruido blanco en residuales vs \(H_1\): Ausencia de ruido blanco en residuales
Esto para poder tener una métrica de la fiabilidad de los respectivos modelos y, por ende, de los pronósticos que éstos generen.
Movilidad en CDMX (Tránsporte público).
Análisis exploratorio.
La base de datos cuenta con las diferencias porcentuales del metro, metrobús, trolebús, rtp y ecobici, los cuales son los medios de trásporte mas recurrentes en la Ciudad, estos pueden presentar correlación entre ellos, por lo cual prodríamos omitir alguno para evitar estudiar información muy parecida en las series.
Consideraremos una alta correlación aquellos por encima de 0.8 en coeficiente de correlación.
hospitalizados_transporte_movilidad <- read.csv('/cloud/project/hospitalizados-transporte-movilidad.csv')
movilidad <- hospitalizados_transporte_movilidad[, c('fecha', 'metro',
'metrobus',
'trolebus',
'rtp',
'ecobici')]
movilidad <- mutate(movilidad, fecha = as.Date(fecha, '%d/%m/%Y'))
corr <- cor(movilidad[,-c(1)])
corr metro metrobus trolebus rtp ecobici
metro 1.0000000 0.6927117 0.6375448 0.8128577 0.6682762
metrobus 0.6927117 1.0000000 0.9031026 0.6334265 0.7931347
trolebus 0.6375448 0.9031026 1.0000000 0.7225076 0.5820793
rtp 0.8128577 0.6334265 0.7225076 1.0000000 0.5427892
ecobici 0.6682762 0.7931347 0.5820793 0.5427892 1.0000000Dado esto, omitimos la información tanto de rtp como de trolebús. Y vemos ahora, de manera gráfica la correlación entre las variables resultantes, notamos que hay correlaciones hasta de 0.79 entre ecobici y metrobús, pero consevaremos estas variables ya que el ecobici es una forma más rápida de transporte y la mayor preferencia de algunas personas. Enfocado al estudio de sus afluencias, es interesante también estudiar este comportamiento.
movilidad <- movilidad[ , -4]
movilidad <- movilidad[ , -4]
corr <- cor(movilidad[,-c(1)])
ggcorrplot(corr, method = "circle",
hc.order = TRUE,
lab = TRUE,
outline.color = "white",
ggtheme = ggplot2::theme_gray,
colors = c("#6D9EC1", "white", "#E46726")) +
ggtitle("Correlograma de los medios de transporte CDMX") +
theme_minimal()
A continuación se presentan histogramas y densidades obtenidas de los datos, notamos que para el metro, los descensos más frecuentes rondan en tre el 40% y 50%, también hay una segunda moda alrededor de 70%, estos resgitros sucedieron al inicio de la restricción social.
El metrobus presenta descensos, en frecuencia relativamente más variables a lo largo del tiempo, siendo las más frecuentes entre 70% y 50%.
Los descensos de afluencia en el uso de ecobici, tienen una mayor frecuencia entre 60% y 70%, siento este rango el más frecuente desde finales de marzo de 2020.
En general, logramos apreciar un descenso importante en la afluencia de estos medios de transporte, lo cuál ers de esperarse.
par(mfrow=c(2, 2))
## Histograma y densidad del metro.
with(movilidad, hist(metro, freq = FALSE,breaks="Sturges", col="lightblue", title='Histograma de
dendsidad de la afluencia en el metro de CDMX'))
lines(density(movilidad$metro), col="blue")
## Histograma y densidad del metrobus.
with(movilidad, hist(metrobus, freq = FALSE, breaks="Sturges", col="orange",title='Histograma de
dendsidad de la afluencia en el metrobús de CDMX'))
lines(density(movilidad$metrobus), col="red")
## Histograma y densidad del ecobici.
with(movilidad, hist(ecobici, freq = FALSE, breaks="Sturges", col="lightgreen",title='Histograma de
dendsidad de la afluencia en ecobici de CDMX'))
lines(density(movilidad$ecobici), col="green")
Series de tiempo.
Iniciemos un pequeño analisis de las respectivas series de estos datos:
Se puede notar la gran disminución significativa durante los ultimos días de marzo alcanzando los mayores mínimos alrededor de finales de abril e inicio de mayo.
Es importante señalar que en todas las series se presentan datos atípicos en las fechas:
- 16 de septiembre de 2020
- 2 de noviembre de 2020
- 16 de noviembre de 2020
- 25 de diciembre de 2020
- 1 de enero de 2021
Estas fechas son considerados días festivos, y el hecho que es descenso sea más significativo se puede explicar por las medidas del Gobierno estos días, cerrando ciertas líneas y estaciones.
####### Serie de tiempo de metro
metro_p <-ggplot(movilidad)+geom_line(aes(x=fecha,y=metro), color="orange", size=0.5)+
geom_point(aes(x=fecha,y=metro), size=0.5)+
ggtitle("Serie de tiempo afluencia en el metro")+
labs(x="Tiempo desde 24/marzo/2020 al 25/enero/2021", y="diferencia porcentual")+
theme_bw()+theme(plot.title = element_text(hjust = 0.5))
ggplotly(metro_p)Notamos que el comportamiento de las series de el metro como de metrobús son bastante parecidas, notando una disminución significativa en el mes de enero por el metro, debido a el problema de incendios presentados en estas fechas click.
####### Serie de tiempo de metrobus
metrobus_p<-ggplot(movilidad)+geom_line(aes(x=fecha,y=metrobus), color="red", size=0.5)+
geom_point(aes(x=fecha,y=metrobus), size=0.5)+
ggtitle("Serie de tiempo de afluencia en el metrobús")+
labs(x="Tiempo desde 24/marzo/2020 al 25/enero/2021", y="diferencia porcentual")+
theme_bw()+theme(plot.title = element_text(hjust = 0.5))
ggplotly(metrobus_p)La serie de la afluencia en ecobici presenta un comportamiento más variable a lo largo del tiempo, presenta sus máximas disminuciones entre abril y julio, lo cual puede causar problemas al momento del ajuste.
####### Serie de tiempo de ecobici
ecobico_p<-ggplot(movilidad)+geom_line(aes(x=fecha,y=ecobici), color="green", size=0.5)+
geom_point(aes(x=fecha,y=ecobici), size=0.5)+
ggtitle("Serie de tiempo de afluencia en ecobici")+
labs(x="Tiempo desde 24/marzo/2020 al 25/enero/2021", y="diferencia porcentual") +
theme_bw()+theme(plot.title = element_text(hjust = 0.5))
ggplotly(ecobico_p)Modelos y predicciones.
Es importante recordar que, al ajustar un modelo, los residuales de este deben comportarse como ruido blanco.
Metro
Para el metro, realizamos la serie de tiempo, y utilizamos la función auto.arima para ajustar el mejor modelo posible a los datos. Para comprobar que es un buen modelo, hacemos el test Ljung-Box, obteniendo un p_value = 0.9735, por lo cual los residuales se comportan como ruido blanco, por lo que el modelo puede ser usado para predecir.
ts_metro <- ts(movilidad$metro, start = c(2020, 3,24),
end = c(2021, 1, 25), frequency = 307)
metro_fit <- auto.arima(ts_metro)
summary(metro_fit) Series: ts_metro
ARIMA(1,1,4)
Coefficients:
ar1 ma1 ma2 ma3 ma4
0.9680 -1.3569 0.1680 0.1290 0.0889
s.e. 0.0373 0.0687 0.0979 0.0935 0.0570
sigma^2 estimated as 21.15: log likelihood=-896.01
AIC=1804.02 AICc=1804.3 BIC=1826.34
Training set error measures:
ME RMSE MAE MPE MAPE MASE ACF1
Training set -0.1076176 4.553463 2.597945 -0.1865995 4.708741 NaN 0.001886462Box.test(residuals(metro_fit), type = 'Ljung-Box') ## p-value = 0.9735
Box-Ljung test
data: residuals(metro_fit)
X-squared = 0.0010997, df = 1, p-value = 0.9735pronostico<-forecast(metro_fit,12,level=95)
plot(pronostico,main="Pronóstico para afluencia en el metro de CDMX.")
NOTA: Las predicciones con series de tiempo con fiables a corto plazo pero van convergiendo a la media al paso de los periodos, por lo que pierden eficacia. Por este motivo las predicciones se realizan para 12 días.
sliderInput(inputId='periodo', label ='Elija el periódo de predicción',
min=1, max=35, value = 12)
renderPlot(plot(forecast(metro_fit,input$periodo,level=95),main="Pronóstico para afluencia en el metro de CDMX."))Metrobús
El procedimiento es analógo, este modelo tampoco presento problemas para ajustar un buen modelo para predecir, ya que su p_value = 0.3256, por lo que no se rechaza que los residuales se comporten como ruido blanco, y presento los siguientes resultados:
ts_metrobus <- ts(movilidad$metrobus, start = c(2020, 3,24),
end = c(2021, 1, 25), frequency = 307)
metrobus_fit <- auto.arima(ts_metrobus)
summary(metrobus_fit) Series: ts_metrobus
ARIMA(3,1,2)
Coefficients:
ar1 ar2 ar3 ma1 ma2
0.9684 -0.6503 -0.2274 -1.3397 0.8824
s.e. 0.0645 0.0731 0.0616 0.0372 0.0345
sigma^2 estimated as 26.82: log likelihood=-933.06
AIC=1878.12 AICc=1878.4 BIC=1900.44
Training set error measures:
ME RMSE MAE MPE MAPE MASE ACF1
Training set 0.09205957 5.12802 3.188772 -0.9871106 6.393434 NaN -0.05591643Box.test(residuals(metrobus_fit), type = 'Ljung-Box') ## p-value = 0.3256
Box-Ljung test
data: residuals(metrobus_fit)
X-squared = 0.96616, df = 1, p-value = 0.3256Tratando de mejorar el modelo, se usan medias móviles de orden 3 para poder suavizar un poco la serie de tiempo, posteriormente se vuelve a ajustar el modelo, el cual arrojo un p-value = 0.8823, mucho mayor al modelo anterior, por lo que, estadísticamente los residuales se comportan como ruido blanco.
ts_metrobus_m <- ma(ts_metrobus, 3)
metrobus_arima <- auto.arima(ts_metrobus_m)
summary(metrobus_arima) Series: ts_metrobus_m
ARIMA(4,1,1)
Coefficients:
ar1 ar2 ar3 ar4 ma1
1.1827 -0.3855 -0.5040 0.4786 -0.7047
s.e. 0.1085 0.0919 0.0811 0.0629 0.1083
sigma^2 estimated as 3.893: log likelihood=-634.24
AIC=1280.47 AICc=1280.76 BIC=1302.76
Training set error measures:
ME RMSE MAE MPE MAPE MASE ACF1
Training set 0.05131676 1.95361 1.296539 -0.02014026 2.598507 NaN -0.0084485Box.test(residuals(metrobus_arima), type = 'Ljung-Box') ## ma = 3, p-value = 0.8823
Box-Ljung test
data: residuals(metrobus_arima)
X-squared = 0.021913, df = 1, p-value = 0.8823pronostico<-forecast(metrobus_arima,12,level=95)
plot(pronostico,main="Pronóstico para afluencia en el metrobús de CDMX.")
De igual manera, se pueden apreciar las predicciones para este modelo, a doce días.
Ecobici.
El modelo inciar con el método auto.arima arrojo los siguientes resultados, cabe recordar que el comportamiento de esta serie era mucho más variables que las dos pasadas:
ts_ecobici <- ts(movilidad$ecobici, start = c(2020, 3,24),
end = c(2021, 1, 25), frequency = 307)
ecobici_fit <- auto.arima(ts_ecobici)
summary(ecobici_fit) Series: ts_ecobici
ARIMA(2,1,2)
Coefficients:
ar1 ar2 ma1 ma2
1.0576 -0.7504 -1.5625 0.7947
s.e. 0.0436 0.0450 0.0381 0.0360
sigma^2 estimated as 54.89: log likelihood=-1042.93
AIC=2095.85 AICc=2096.05 BIC=2114.46
Training set error measures:
ME RMSE MAE MPE MAPE MASE ACF1
Training set 0.1033292 7.347775 5.597451 -1.640404 9.565879 NaN -0.06304068Box.test(residuals(ecobici_fit), type = 'Ljung-Box') ## p-value = 0.2678
Box-Ljung test
data: residuals(ecobici_fit)
X-squared = 1.228, df = 1, p-value = 0.2678Observamos que la función arrojo un modelo ARIMA(2,1,2), con 2 componentes autorregresivos, 2 medias móviles y una diferencia, sin embargo notamos que la prueba Box-Ljung arrojo un p_value = 0.2678, para ciertos níveles de significancia más altos podría no ser un gran modelo.
Al igual que el metodo anterior, usaremos medias móviles de orden 3 para suavizar la serie, obteniendo un modelo ARIMA(5,1,0) con un p-value en la prueba Ljung-Box igual a 0.5439, por lo que es un modelo estadísticamente mejor que es anterior y por lo tanto puede ser usado para hacer pronósticos.
ts_ecobici_m <- ma(ts_ecobici, 3)
ecobici_arima <- auto.arima(ts_ecobici_m)
summary(ecobici_arima) Series: ts_ecobici_m
ARIMA(5,1,0)
Coefficients:
ar1 ar2 ar3 ar4 ar5
0.1136 -0.3448 -0.4769 -0.2709 -0.3457
s.e. 0.0545 0.0527 0.0487 0.0526 0.0548
sigma^2 estimated as 6.192: log likelihood=-705.32
AIC=1422.63 AICc=1422.92 BIC=1444.92
Training set error measures:
ME RMSE MAE MPE MAPE MASE ACF1
Training set 0.04659891 2.463763 1.919789 -0.03488921 2.979609 NaN 0.03463605Box.test(residuals(ecobici_arima), type = 'Ljung-Box') ## ma = 2, p-value = 0.2999
Box-Ljung test
data: residuals(ecobici_arima)
X-squared = 0.36831, df = 1, p-value = 0.5439 ## ma = 3, p-value = 0.5439pronostico<-forecast(ecobici_arima,12,level=95)
plot(pronostico,main="Pronóstico para afluencia en ecobici en CDMX.")
Movilidad en CDMX (Tránsporte particular).
Es interesante igualmente, estudiar el comportamiento de los automoviles particulares en la CDMX, ya que es una de las manera de movílidad más comunes, y por ende, podría ser el más itulizado durante el periodo de pandemia.
Análisis exploratorio.
La diferencias porcentuales con mayor frecuencia para el uso de autos partuculares ronda, mayormente, en descensos entre 40% y 60%, se presentaron también descensos de 80% en movilidad de vehículos, podría ser explicado por la medidas de Hoy no círcula, implementadas por el Gobierno ya que, este programa se extendío a todos los coches para finales de abril (Más información).
automoviles <- hospitalizados_transporte_movilidad[, c('fecha', 'transito')]
automoviles <- mutate(automoviles, fecha = as.Date(fecha, '%d/%m/%Y'))
with(automoviles, hist(transito, freq = FALSE, breaks="Sturges", col="gray"))
lines(density(automoviles$transito), col="black", lty=3, lwd=4)
Serie de tiempo.
Esta serie de tiempo ha presentado un comportamiento muy similar a las tres anteriores, presentando sus mayores descensos entre abril y julio, y teniendo una tendencia creciente a partir de este mes antes mencionado.
Los putno atípicos se presnetan en las mismas fechas que las series anteriores, es decir, en los días festivos.
Presenta también un gran descenso a finales de diciembre y principios de enero.
autos_p<-ggplot(automoviles)+geom_line(aes(x=fecha,y=transito), color="purple", size=0.5)+
geom_point(aes(x=fecha,y=transito), size=0.5)+
ggtitle("Series de tiempo de afluencia en transportes particulares.")+
labs(x="Tiempo desde 24/marzo/2020 al 25/enero/2021", y="automovil") +
theme_bw()+theme(plot.title = element_text(hjust = 0.5))
ggplotly(autos_p)Modelos y predicciones.
El ajuste de esta serie de tiempo dio los siguientes resultados:
- El mejor modelo ajustado es un ARIMA(5,1,2), con 5 componenetes autorregresivos, una diferencia y dos componenetes de medias móviles.
- EL p_value de la prueba Box-Ljung dio 0.9489, por lo que los residuales presentan un comportamiento de ruido blanco, y se puede decir que es un buen modelo, por lo que se puede utilizar para predicciones.
ts_autos <- ts(automoviles$transito, start = c(2020, 3,24),
end = c(2021, 1, 25), frequency = 307)
autos_fit <- auto.arima(ts_autos)
summary(autos_fit) Series: ts_autos
ARIMA(5,1,2)
Coefficients:
ar1 ar2 ar3 ar4 ar5 ma1 ma2
0.5872 -0.5691 -0.2482 -0.1921 -0.1612 -1.2027 0.7801
s.e. 0.1107 0.0716 0.0758 0.0668 0.0762 0.0984 0.0657
sigma^2 estimated as 69.69: log likelihood=-1077.27
AIC=2170.54 AICc=2171.02 BIC=2200.3
Training set error measures:
ME RMSE MAE MPE MAPE MASE ACF1
Training set 0.1226657 8.237961 5.630008 -2.243657 10.71757 NaN -0.003647203Box.test(residuals(autos_fit), type = 'Ljung-Box') ## p-value = 0.9489
Box-Ljung test
data: residuals(autos_fit)
X-squared = 0.0041105, df = 1, p-value = 0.9489pronostico<-forecast(autos_fit,12,level=95)
plot(pronostico,main="Pronóstico para afluencia de vehículos particulares en CDMX")
Tráfico en servicios de Internet.
De todos los proveedores, seleccionaremos a los 3 que mas datos generan de manera local asi como 1 de los que menos generan.
#Grafica de area.
ggplot(datos_internet, aes(x = Fecha, y = Trafico_Datos_Local)) +
geom_area(aes(color = Proveedor, fill = Proveedor),
alpha = 0.5, position=position_dodge(0.8)) +
ggtitle("Trafico de datos durante la pandemia") +
xlab("Mes 2020") +
ylab("Datos en GB") +
theme_minimal() +
scale_color_manual(values=c("#00AFBB", "#E7B800", "#CC0000", "#006600",
"#669999", "#00CCCC", "#660099", "#FC0066",
"#AF9999", "#FE99FF", "#559955", "#A990CC",
"#660099", "#CC0066")) +
scale_fill_manual(values=c( "#00AFBB", "#E7B800", "#CC0000", "#006600",
"#669999", "#00CCCC", "#660099", "#FC0066",
"#AF9999", "#FE99FF", "#559955", "#A990CC",
"#660099", "#CC0066"))
En este caso fueron seleccionados: Movistar, Unefon, Clarovideo y DirecTV.
Series de tiempo.
Vayamos a realizar un analisis ganeral de las series de tiempo que nos proporcionan los proveeedores de servicios. Tras observar cada una de las series, se puede llegar a un punto en comun, todas tienen puntos de inflexion cerca de los meses de Julio, Agosto y Enero, ya que estos son los meses de transicion de vacaciones a clases/trabajo o viceversa por parte de estudiantes o trabajadores; Por motivos de la pandemia, el regreso a labores se debe de realizar de manera puramente virtual y en algunos escasos casos de manera semipresencial. ¿A que va esto?, pues a que todo mundo ahorita depende de servicios de internet o de entretenimiento ya que por decreto oficial, nadie deberia de salir de su casa.
NOTA. Los datos atipicos de las graficas fueron “Normalizados”, sustituyendo el dato por el promedio del dato de un dia anterior con el de un dia posterior, esto con el fin de brindar un buen modelo de prediccion.
grafica_movi <- ggplot(movistar) +
geom_line(aes(x=Fecha, y= Trafico_Datos_Local), color="green", size=0.8) +
geom_point(aes(x=Fecha, y= Trafico_Datos_Local), size=1) +
ggtitle("Movistar") +
labs(x="Tiempo", y="Datos (GB)") +
theme_bw() +
theme(plot.title = element_text(hjust = 0.5))
ggplotly(grafica_movi)Antes que nada, se debe aclarar que la compañia “Movistar” es una empresa de servicios telefonia movil, cuyo proposito es comunicar a los cientos de miles de mexicanos con el mundo exterior y de manera local. En esta grafica se puede observar el alce de la demanda de servicios telefonicos justo cuando empezo el periodo vacacional y una caida una vez se regreso a dias laborales.
grafica_une <- ggplot(une) +
geom_line(aes(x=Fecha, y= Trafico_Datos_Local), color="yellow", size=0.8) +
geom_point(aes(x=Fecha, y= Trafico_Datos_Local), size=1) +
ggtitle("Unefon") +
labs(x="Tiempo", y="Datos (GB)") +
theme_bw() +
theme(plot.title = element_text(hjust = 0.5))
ggplotly(grafica_une)Como dato previo al analisis, se debe aclarar que la compañia “Unefon” es una empresa de servicios telefonia movil, cuyo proposito es comunicar a los cientos de miles de mexicanos con el mundo exterior y de manera local. En esta grafica se puede observar la misma demanda que tuvo movistar, pero con una mayor cantidad de usuarios asociados a esta telefonia al principio, tambien demuestra el alce de la demanda de servicios telefonicos justo cuando empezo el periodo vacacional y una caida una vez se regreso a dias laborales.
grafica_claro <- ggplot(claro) +
geom_line(aes(x=Fecha, y= Trafico_Datos_Local), color="red", size=0.8) +
geom_point(aes(x=Fecha, y= Trafico_Datos_Local), size=1) +
ggtitle("Claro") +
labs(x="Tiempo", y="Datos (GB)") +
theme_bw() +
theme(plot.title = element_text(hjust = 0.5))
ggplotly(grafica_claro)Como dato previo, se debe aclarar que la compañia “Claro” es una empresa de servicios internet y telefonia fija, asi como servicios de entretenimiento en linea, cuyo proposito es de brindar un servicio total a sus clientes. En esta grafica se puede observar un cambio significativo con respecto a las empresas anteriores, como esta es una empresa mas orientado a lo “fijo” y al entretenimiento, por motivos de confinamiento agarro mas fuerza y tuvo un incremento desde el inicio de la pandemia; como las personas se la pasan en su hogar, necesitan una forma de pasar el tiempo y que mejor con los servicios de entretenimiento qye ofrece esta empresa y ademas, si estas en casa, no hay necesidad de tener un plan movil de internet si ya tienes internet fijo.
grafica_directv <- ggplot(directv) +
geom_line(aes(x=Fecha, y= Trafico_Datos_Local), color="blue", size=0.8) +
geom_point(aes(x=Fecha, y= Trafico_Datos_Local), size=1) +
ggtitle("Directv") +
labs(x="Tiempo", y="Datos (GB)") +
theme_bw() +
theme(plot.title = element_text(hjust = 0.5))
ggplotly(grafica_directv)Como dato previo, se debe aclarar que la compañia “Directv” es una empresa de servicios de television por cable, cuyo proposito es de brindar canales exclusivos que no se pueden obtener a traves de television abierta a sus clientes. En esta grafica se puede observar un cambio significativo con respecto a las empresas anteriores, y un comportamiento casi contrario con respecto a Claro, ya que esta tambien provee servicio de entretenimiento, pero ¿Porque?. Muy facil!, el internet agarro gran fuerza, reemplazando asi la television abierta y por cable desde el momento en que salio y empresas exclusivas de entretenimiento que solo pueden ser visitados a traves de internet y de popularidad masiva, aprovecharon la pandemia para lanzar una gran cantidad de espectaculos, logrando asi que muchas personas que tenian television por cable, cancelaran el servicio porque en internet podian encontrar mas variedad y hasta los mismos programas por un precio mas barato o inclusive gratis!
Como breve conclusion de las graficas anteriores, Ante el confinamiento, los servicios de telefonía e internet fijos así como la TV de paga fueron los servicios que tomaron mayor fuerza al elevar sus ingresos y captar más clientes.
Modelos y Predicciones.
Es importante recordar que, al ajustar un modelo, los residuales de este deben comportarse como ruido blanco.
Para las empresas a analizar (Movistar, Claro, Unefon y DirecTV), se realizaron series de tiempo, asi como uso de la la función auto.arima para ajustar el mejor modelo posible a los datos. Para comprobar son buenos modelos, se hizo el test Ljung-Box.
Movistar.
ts_movistar = ts(movistar$Trafico_Datos_Local, start = c(2020,3,30),
end = c(2021,1,26), frequency = 305)
modelo_arima_movistar <- auto.arima(ts_movistar)
summary(modelo_arima_movistar) Series: ts_movistar
ARIMA(2,1,2)
Coefficients:
ar1 ar2 ma1 ma2
1.2261 -0.9438 -1.3585 0.8792
s.e. 0.0318 0.0376 0.0285 0.0521
sigma^2 estimated as 495865982: log likelihood=-3462.44
AIC=6934.88 AICc=6935.09 BIC=6953.45
Training set error measures:
ME RMSE MAE MPE MAPE MASE ACF1
Training set 218.0964 22084.16 17076.06 -0.07347595 3.377077 NaN -0.2521025Test Ljung-Box:
#Ver si es un buen modelo.
Box.test(residuals(modelo_arima_movistar), type = 'Ljung-Box')
Box-Ljung test
data: residuals(modelo_arima_movistar)
X-squared = 19.512, df = 1, p-value = 9.996e-06Se puede observar que el ajuste arrojo un modelo ARIMA (2,1,2), con 2 componentes autorregresivos, 2 medias móviles y una diferencia, Sin embargo notamos que la prueba Ljung-Box obtuvo un p_value = 9.996e-06, lo cual nos indica por contraste de hipotesis que los residuales no se comportan como ruido blanco; por lo que el modelo no puede ser usado para predecir.
Para obtener un modelo que nos sirva para predicciones y para corregir la media de los residuales, usaremos medias móviles de orden 2 para suavizar la serie; ya evaluada la serie de tiempo, se logro obtener los siguientes resultados:
ts_movistar = ts(movistar$Trafico_Datos_Local, start = c(2020,3,30),
end = c(2021,1,26), frequency = 305)
#Suavizamos el modelo para obtener una mejor prediccion.
ma_ts_movistar <- ma(ts_movistar,2)
modelo_arima_movistar <- auto.arima(ma_ts_movistar)
summary(modelo_arima_movistar) Series: ma_ts_movistar
ARIMA(2,1,0) with drift
Coefficients:
ar1 ar2 drift
0.8830 -0.7363 327.0304
s.e. 0.0397 0.0396 592.8968
sigma^2 estimated as 77445501: log likelihood=-3160.37
AIC=6328.74 AICc=6328.87 BIC=6343.56
Training set error measures:
ME RMSE MAE MPE MAPE MASE ACF1
Training set 12.95543 8741.838 7193.542 0.0220436 1.433119 NaN 0.02727393Test Ljung-Box para el modelo suavizado:
#Ver si es un buen modelo.
Box.test(residuals(modelo_arima_movistar), type = 'Ljung-Box')
Box-Ljung test
data: residuals(modelo_arima_movistar)
X-squared = 0.22689, df = 1, p-value = 0.6338Tras realizar estas modificaciones, el nuevo ajuste nos arrojo un modelo ARIMA(2,1,0) con 2 componentes autorregresivos, 0 medias móviles y una diferencia. Ahora tras realizar la prueba Ljung-Box se obtuvo un p_value = 0.6338, lo cual nos indica que los residuales se comportan como ruido blanco y es un modelo que se puede usar para realizar pronosticos.
Tras haber ajustado el modelo, se pudo obtener el siguiente pronostico:
#Ver si es un buen modelo.
prediccion_movistar <- forecast(modelo_arima_movistar,10,level=95)
plot(prediccion_movistar, main="Pronostico para Movistar.")
Claro.
ts_claro = ts(claro$Trafico_Datos_Local, start = c(2020,3,30),
end = c(2021,1,26), frequency=305)
modelo_arima_claro <- auto.arima(ts_claro)
summary(modelo_arima_claro) Series: ts_claro
ARIMA(3,1,2)
Coefficients:
ar1 ar2 ar3 ma1 ma2
0.8657 -0.5184 -0.3363 -1.3552 0.7906
s.e. 0.0610 0.0719 0.0620 0.0375 0.0690
sigma^2 estimated as 3.283e+09: log likelihood=-3748.74
AIC=7509.48 AICc=7509.76 BIC=7531.76
Training set error measures:
ME RMSE MAE MPE MAPE MASE ACF1
Training set 1332.516 56730.32 46538.55 -0.09503242 4.399208 NaN -0.09772703Test Ljung-Box:
#Ver si es un buen modelo.
Box.test(residuals(modelo_arima_claro), type = 'Ljung-Box')
Box-Ljung test
data: residuals(modelo_arima_claro)
X-squared = 2.9321, df = 1, p-value = 0.08683Se puede observar que el ajuste arrojo un modelo ARIMA (3,1,2), con 3 componentes autorregresivos, 2 medias móviles y una diferencia, Sin embargo notamos que la prueba Ljung-Box obtuvo un p_value = 0.0868, lo cual nos indica que los residuales se comportan como ruido blanco. El problemas es que; para muchos níveles de significancia podría no ser un gran modelo.
Para obtener un modelo que nos sirva para predicciones y para corregir la media de los residuales, agregamos otra diferencia al modelo ARIMA; en base a esto, se logro obtener los siguientes resultados:
ts_claro = ts(claro$Trafico_Datos_Local, start = c(2020,3,30),
end = c(2021,1,26), frequency=305)
modelo_arima_claro <- Arima(ts_claro, order = c(3,2,2))
summary(modelo_arima_claro) Series: ts_claro
ARIMA(3,2,2)
Coefficients:
ar1 ar2 ar3 ma1 ma2
0.4597 -0.2298 -0.3165 -1.8154 0.8304
s.e. 0.0623 0.0602 0.0597 0.0371 0.0367
sigma^2 estimated as 4.065e+09: log likelihood=-3770.64
AIC=7553.28 AICc=7553.57 BIC=7575.54
Training set error measures:
ME RMSE MAE MPE MAPE MASE ACF1
Training set -32.53311 63016.1 50555.39 -0.2353234 4.757215 NaN -0.08174628Test Ljung-Box para el modelo ajustado:
#Ver si es un buen modelo.
Box.test(residuals(modelo_arima_claro), type = 'Ljung-Box')
Box-Ljung test
data: residuals(modelo_arima_claro)
X-squared = 2.0516, df = 1, p-value = 0.152Tras realizar estas modificaciones, el nuevo ajuste nos arrojo un modelo ARIMA(3,2,2) con 2 componentes autorregresivos, 2 medias móviles y 2 diferencias. Ahora tras realizar la prueba Ljung-Box se obtuvo un p_value = 0.152, lo cual nos indica que los residuales se comportan como ruido blanco y es un modelo mejor que al anterior, pero indica que; para ciertos níveles de significancia más altos podría no ser un gran modelo.
Tras haber ajustado el modelo, se pudo obtener el siguiente pronostico:
#Ver si es un buen modelo.
prediccion_claro <- forecast(modelo_arima_claro,10,level=95)
plot(prediccion_claro, main="Pronostico para Claro")
Unefon.
ts_unefon = ts(une$Trafico_Datos_Local,start = c(2020,3,30),
end = c(2021,1,26), frequency=305)
modelo_arima_unefon <- auto.arima(ts_unefon)
summary(modelo_arima_unefon) Series: ts_unefon
ARIMA(4,1,2)
Coefficients:
ar1 ar2 ar3 ar4 ma1 ma2
0.651 -0.5627 -0.1949 -0.2961 -1.1882 0.7989
s.e. 0.070 0.0715 0.0673 0.0621 0.0462 0.0603
sigma^2 estimated as 1.412e+09: log likelihood=-3620.2
AIC=7254.4 AICc=7254.78 BIC=7280.4
Training set error measures:
ME RMSE MAE MPE MAPE MASE ACF1
Training set 104.3386 37145.56 28972.25 -0.1464995 3.562211 NaN -0.02945804Test Ljung-Box:
#Ver si es un buen modelo.
Box.test(residuals(modelo_arima_unefon), type = 'Ljung-Box')
Box-Ljung test
data: residuals(modelo_arima_unefon)
X-squared = 0.26642, df = 1, p-value = 0.6057Se puede observar que el ajuste arrojo un modelo ARIMA (4,1,2), con 4 componentes autorregresivos, 2 medias móviles y una diferencia, Sin embargo notamos que la prueba Ljung-Box obtuvo un p_value = 0.6057, lo cual nos indica que los residuales se comportan como ruido blanco y es un buen modelo para generar predicciones.
Tras el ajuste del modelo, se pudo obtener el siguiente pronostico:
#Ver si es un buen modelo.
prediccion_unefon <- forecast(modelo_arima_unefon, 12, level=95)
plot(prediccion_unefon, main="Pronostico para Unefon")
DirecTV.
ts_directv = ts(directv$Trafico_Datos_Local, start = c(2020,3,30),
end = c(2021,1,26), frequency=305)
modelo_arima_directv <- auto.arima(ts_directv, seasonal=TRUE)
summary(modelo_arima_directv) Series: ts_directv
ARIMA(2,1,2) with drift
Coefficients:
ar1 ar2 ma1 ma2 drift
1.1069 -0.663 -1.3949 0.5808 -8.5755
s.e. 0.0692 0.064 0.0727 0.0709 35.1089
sigma^2 estimated as 3362602: log likelihood=-2704.81
AIC=5421.62 AICc=5421.9 BIC=5443.9
Training set error measures:
ME RMSE MAE MPE MAPE MASE ACF1
Training set 11.12746 1815.554 1440.87 -0.0728653 2.683842 NaN -0.07059401Test Ljung-Box:
#Ver si es un buen modelo.
Box.test(residuals(modelo_arima_directv), type = 'Ljung-Box')
Box-Ljung test
data: residuals(modelo_arima_directv)
X-squared = 1.53, df = 1, p-value = 0.2161Se puede observar que el ajuste arrojo un modelo ARIMA (2,1,2), con 2 componentes autorregresivos, 2 medias móviles y una diferencia, Sin embargo notamos que la prueba Ljung-Box obtuvo un p_value = 0.2161, lo cual nos indica que los residuales se comportan como ruido blanco; pero indica que; para ciertos níveles de significancia más altos podría no ser un gran modelo.
Tras el ajuste del modelo, se pudo obtener el siguiente pronostico:
#Ver si es un buen modelo.
prediccion_directv <- forecast(modelo_arima_directv, 12, level=95)
plot(prediccion_directv, main="Pronostico para Directv")
Precio del dólar.
A lo largo de los 286 días registrados observamos un promedio de 22.08 y 22.04 de apertura y cierre respectivamente. El segundo cuartil (la mediana) se encuentra entre 22.14 y 22.10.
El máximo (max) y el mínimo (min) son los picos y los valles que tuvo el valor a lo largo del día. A lo largo de los 286 días registrados observamos un promedio de 22.28 y 22.87 de máximo y mínimo respectivamente. El segundo cuartil (la mediana) se encuentra entre 22.25 y 21.93.
summary( select(datosmut, Apertura, Cierre, max, min)) Apertura Cierre max min
Min. :19.77 Min. :19.77 Min. :19.90 Min. :19.69
1st Qu.:21.12 1st Qu.:21.12 1st Qu.:21.30 1st Qu.:21.00
Median :22.14 Median :22.10 Median :22.25 Median :21.93
Mean :22.08 Mean :22.04 Mean :22.28 Mean :21.87
3rd Qu.:22.76 3rd Qu.:22.74 3rd Qu.:22.95 3rd Qu.:22.62
Max. :25.36 Max. :25.34 Max. :25.76 Max. :24.67En el gráfico podemos apreciar que es una serie No estacionaria pues su distribución y sus parámetros varian a lo largo de la serie de tiempo, en otras palabras:
-La media no es constante pues decrementa a lo largo del tiempo -Su varianza tampoco es una constante.
Cabe recalcar que, por lo general, en los indicadores de activos financieros no se encuentran datos estacionales.
Dada la volatilidad que presenta la serie, se suaviza por medio de el uso de medias móviles de orden 3, con el fin de tene una serie más sencilla de ajustar.
Con esta serie suavizada se puede ajustar el mejor modelo posible a los datos, obteniendo un modelo ARIMA(3,1,1), con 3 componentes autorregresivos, una diferencia a los datos y un componente autorregresivo.
Este modelo produjo un p-value = 0.893, en la prueba Ljung-Box, por lo que los residuales, estadísticamente, se comportan como ruido blanco, por lo que el modelo puede ser usado para obtener pronósticos a corto plazo con un buen nivel de confianza.
prueba1 <- auto.arima(serie1)
summary(prueba1) Series: serie1
ARIMA(3,1,1) with drift
Coefficients:
ar1 ar2 ar3 ma1 drift
0.3560 0.2480 -0.4459 0.4426 -0.0218
s.e. 0.1115 0.0959 0.0718 0.1074 0.0126
sigma^2 estimated as 0.01122: log likelihood=168.81
AIC=-325.63 AICc=-325.2 BIC=-305.78
Training set error measures:
ME RMSE MAE MPE MAPE MASE
Training set -0.00114181 0.1043634 0.0752166 -0.003481622 0.3363488 NaN
ACF1
Training set 0.009374614Box.test(residuals(prueba1), type = 'Ljung-Box')
Box-Ljung test
data: residuals(prueba1)
X-squared = 0.018105, df = 1, p-value = 0.893pronos <- forecast(prueba1,12,level=95)El modelo ajustado otorgo estos pronósticos del precio de cierre del dólar:
pronos_dolar <- forecast(prueba1,12,level=95)
plot(pronos_dolar, main="Pronostico para el precio del dólar. ")
Conclusiones.
Respecto a la movilidad:
Los modelos ajustados a la serie de tiempo referente al metro de la ciudad de México, pronoótico que las diferencia porcentuales, al estas fechas (principios de febrero), rondarán alrededor del 74% al 75% de reducción de afluencia respecto a un día típico.
Los datos registrados del uso de metrobús pronósticaron que la afluencia en este medio de transporte podría registrar un descenso respecto a un día típico de valores entre 32.9% y 35%.
La serie de tiempo respecto al uso de la ecobici, al ser la que presentabá mayor variabilidad produjó que los pronóstivcos también presentarán mucha variabilidad, prediciendo descensos en la afluencia en este medio de transporte que varían entre 49% hasta pronósticos de 65%.
La serie de tiempo acerca de el uso de autómoviles particulares fue de las series que presentó mejor p-value en la prueba Ljung-Box, y los pronósticos del modelo resultando arrojan descensos en la afluencia desde un 48% hasta un 52.5% respecto a un día típico.
Cabe resaltar que los valores predichos son un pronótico respecto a un modelo matemático y pueden presentar variación respecto a días atípicos que se puedan presentar en el periodo de predicción.
Respecto al uso de datos:
El modelos ajustado para el uso de GB de la telefonía Movistar presentó pronósticos de uso de entre 515 mil y 558 mil GB diarios, mientras que los intervalos de confianza presentaron valores por encima de los 464 GB hasta un posible máximo de 620 GB diarios.
Recordemos que uno de los modelos más complejos de ajustar fue el relacionado con el uso de servicios de Marca Claro, para esta prestadora de servicios en línea se predijeron valores de uso de entre 1.15 millones de GB hasta un valor calculado de 1.29 millones de GB diarios.
Respecto a la compañía telefónica Unefon, el modelo ajustado arrojo un consumo de GB que podría rondar entre 885 mil GB diarios hasta un posible valor pronósticado máximo de 951 mil GB diarios, comparando las dos telefonías, es la que presenta un mayor uso de GB, y lo pronósticos tambíen consideraron esa tendencia.
Para directTV, la prestadora de servicio de televisión de paga, el modelo ajustado pronóstico que el uso de GB de los usuarios al día podrían rondar entre 51.8k Gb diarios hasta un posible máximo de 54.2k GB diarios.
Con esta predicciones se puede notar que, en periodo de pandemia, los usuarios prefieren utilizar servicios de telecomunicación que usar servicios de televisión por cable.
Respecto al precio del dólar.
La tendencia del precio del dólar se veía a la baja desde las series de tiempo, mientras que el modelo ajustado pronóstico que el precio podría oscilar entre 19.5 hasta 19.7 pesos, esto con intervalos de confianza deposibles mínimos entre 18.2 hasta posibles máximos de 20.87 pesos; esto para los precios de cierre. Si bien es verdad que esta variable es extremadamente sencible a los cambios y sucesos de diversos sectores, las predicciones oscilan entre intervalos muy pequeños.
Notas importantes.
Para interactuar de mejor manera con los datos y resultados hemos desarollado una pequeña aplicación, la cual puede tener acceso mediante el siguiente link.